home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS11.ADF / Modula-2 / CaseConvert / symbols.mod < prev    next >
Text File  |  1986-08-05  |  4KB  |  163 lines
  1. (* 
  2.     MODULE - Symbols.
  3.     
  4.     The symbol table is a hash table. The collisions are
  5.     resolved by using a hash table with chaining
  6.  
  7.     Created:  3/26/85 by Richie Bielak
  8.  
  9.     Modified: 4/2/86 by Richie Bielak
  10.               - Create heap required on the Amiga.
  11.               - Use procedures from "String" module.
  12.  
  13.  
  14.  
  15.    Copyright (c) 1986 - by Richie Bielak
  16.    
  17.    This program maybe freely copied, but please leave my name in.
  18.    Thanks....Richie
  19.  
  20. *)
  21.  
  22. IMPLEMENTATION MODULE Symbols;
  23.  
  24. FROM Terminal IMPORT WriteString, WriteLn;
  25. FROM Storage  IMPORT ALLOCATE, CreateHeap;
  26. FROM String   IMPORT Length;
  27.  
  28. CONST
  29.  TableSize = 1001;       (* This should be a prime *)
  30.  BufferSize = 1024 * 4;  (* Size of character buffer *)
  31.  
  32. TYPE
  33.  (* Types for character buffers *)
  34.  CharBuffer    = ARRAY [1..BufferSize] OF CHAR;
  35.  CharBufferPtr = POINTER TO CharBuffer;
  36.  
  37.  NodePtr = POINTER TO Node;
  38.  Node = RECORD
  39.          Next  : NodePtr;
  40.          Index : CARDINAL;       (* Index in the buffer *)
  41.         END;
  42.  
  43. VAR
  44.  HashTable : ARRAY [0..TableSize-1] OF NodePtr;
  45.  BuffPtr   : CharBufferPtr;
  46.  CurrentBufPos : CARDINAL;
  47.  
  48. (* Hash the symbol - but ignore the case *)
  49. PROCEDURE Hash (VAR S : ARRAY OF CHAR; Len : CARDINAL) : CARDINAL;
  50.  VAR
  51.    h, i : CARDINAL;
  52.  BEGIN
  53.    h := ORD(CAP(S[0]));
  54.    FOR i := 1 TO Len-1 DO
  55.      h := (h * 4 + ORD(CAP(S[i]))) MOD TableSize;
  56.    END;
  57.    RETURN h
  58.  END Hash;
  59.  
  60.  
  61. (* Insert a new symbol. User must worry about uniqueness *)
  62. PROCEDURE InsertSymbol (VAR Symbol : ARRAY OF CHAR);
  63.  VAR
  64.    Len : CARDINAL;
  65.    temp : NodePtr;
  66.    i : CARDINAL;
  67.  
  68.   (* This procedure stores a string in the buffer *)
  69.   PROCEDURE StoreString (VAR S : ARRAY OF CHAR; Len : CARDINAL);
  70.    VAR
  71.      i : CARDINAL;
  72.    BEGIN
  73.      (* Now store the string *)
  74.      FOR i := 0 TO Len-1 DO
  75.        BuffPtr^[CurrentBufPos + i] := S[i];
  76.      END;
  77.      INC(CurrentBufPos, Len);
  78.      (* Mark the end of string with a null character *)
  79.      BuffPtr^[CurrentBufPos] := 0C; INC(CurrentBufPos);
  80.    END StoreString;
  81.  
  82.  BEGIN
  83.    Len := Length (Symbol);
  84.    IF Len > 0 THEN
  85.      (* If the current buffer is full, crash!! *)
  86.      IF (CurrentBufPos + Len) > BufferSize THEN
  87.        WriteString ("**** Buffer overflow "); WriteLn;  HALT
  88.      END;
  89.      (* Make a new node *)
  90.      NEW (temp);
  91.      temp^.Index := CurrentBufPos;
  92.      (* Store the string *)
  93.      StoreString(Symbol, Len);
  94.      (* Finally insert it in the hash table *)
  95.      i := Hash (Symbol, Len);
  96.      WITH temp^ DO
  97.        Next := HashTable[i]; HashTable[i] := temp
  98.      END;
  99.    END
  100.  END InsertSymbol;
  101.  
  102. (* Find a symbol, and return it in the form it occurs in the table *)
  103. PROCEDURE FindSymbol (VAR KeySymbol : ARRAY OF CHAR;
  104.                       VAR RetSymbol : ARRAY OF CHAR) : BOOLEAN;
  105.  VAR
  106.    Len, i : CARDINAL;
  107.    temp   : NodePtr;
  108.    Found  : BOOLEAN;
  109.  
  110.  (* Compare an array to a string in a buffer - ingnore case *)
  111.  PROCEDURE Equal (VAR S : ARRAY OF CHAR; Len : CARDINAL; Ptr : NodePtr) 
  112.                  : BOOLEAN;
  113.   VAR
  114.    i : CARDINAL;
  115.   BEGIN
  116.     (* Symbols must be the same length to be equal *)
  117.     (* The symbol in the buffer starts at position *)
  118.     (* "Ptr^.Index", so "Len" characters from it   *)
  119.     (* there should be a NULL.                     *)
  120.     IF BuffPtr^[Ptr^.Index + Len] <> 0C THEN RETURN FALSE END;
  121.     FOR i := 0 TO Len-1 DO
  122.       IF CAP(S[i]) <> CAP(BuffPtr^[Ptr^.Index+i]) THEN RETURN FALSE END
  123.     END;
  124.     RETURN TRUE
  125.   END Equal;
  126.  
  127.  BEGIN
  128.    Found := FALSE;
  129.    (* First hash the key *)
  130.    Len := Length (KeySymbol);
  131.    IF Len > 0 THEN
  132.      i := Hash (KeySymbol,Len);
  133.      temp := HashTable[i];
  134.      (* Now search the list *)
  135.      WHILE (temp <> NIL) AND (NOT Equal(KeySymbol,Len,temp)) DO
  136.        temp := temp^.Next
  137.      END;
  138.      (* If we found it, copy the symbol to the output variable *)
  139.      IF temp <> NIL THEN
  140.        FOR i := 0 TO Len DO (* By going until "len" we also copy the Null *)
  141.          RetSymbol[i] := BuffPtr^[temp^.Index+i]
  142.        END; (* FOR *)
  143.        Found := TRUE
  144.      END
  145.    END;
  146.    RETURN Found
  147.  END FindSymbol;
  148.  
  149. VAR
  150.   i : CARDINAL;
  151.  
  152. BEGIN (* Main *)
  153.   (* Create a heap *)
  154.   IF NOT  CreateHeap (BufferSize * 4) THEN
  155.     WriteString ("Symbols-- unable to create heap "); WriteLn; HALT
  156.   END;
  157.   (* Initialize *)
  158.   FOR i := 0 TO TableSize-1 DO HashTable[i] := NIL END;
  159.   (* Allocate a buffer for the strings *)
  160.   CurrentBufPos := 1;
  161.   NEW (BuffPtr);
  162. END Symbols.
  163.